home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pnl006.zip / GLOBALS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-17  |  15KB  |  612 lines
  1. unit Globals;
  2.  
  3.  
  4. interface
  5.  
  6.  
  7. const
  8.     Black_S     =   8 ; {Black square color (grey)}
  9.     White_S     =   3 ; {White square color (cyan)}
  10.     Black_P     =   0 ; {Black piece color (black)}
  11.     White_P     =  15 ; {White piece color {white)}
  12.  
  13.  
  14. type
  15.    Piece_Type = (nopiece, pawn, rook, knight, bishop, queen, king);
  16.    Side_Type = (noside, white, black);
  17.    Mode_Type = (expert, novice, replaying);
  18.    Flag_Type = (allowed, denied);
  19.     Move_Kind_Type = (KSC,QSC,Capture,EPCapture,Normal,Check,Mate,
  20.                      ShowLegal, Checkall);
  21.    Move_Type = record
  22.       From_F  : char;
  23.       From_R  : integer;
  24.       To_F    : char;
  25.       To_R    : integer;
  26.       Piece_Side: Side_Type;
  27.       Move_Piece: Piece_Type;
  28.       Take_Piece: Piece_Type;
  29.       Move_Kind:  Move_Kind_Type;
  30.  
  31.       Move_Desc:  string[21];
  32.    end;
  33.    Position_Type = record
  34.       Side:  Side_Type;
  35.       Piece: Piece_Type;
  36.    end;
  37.    Move_History_Type = array[1..300] of Move_Type;
  38.    Coord_Type = record
  39.       XFile: char;
  40.       Rank: integer;
  41.    end;
  42.    Coord_List_Type = array[1..27] of Coord_Type;
  43.    Game_State_Type = record
  44.       Side_to_Move:  Side_Type;
  45.       Move_Number:   1..300;
  46.       Mode:  Mode_Type;
  47.       Game_Started:  boolean;
  48.       WKSC_flag,
  49.       BKSC_flag,
  50.       WQSC_flag,
  51.       BQSC_flag:  Flag_Type;
  52.       WEP_flag,
  53.       BEP_flag:   array['a'..'h'] of Flag_Type;
  54.       FileName,
  55.       Comment:  string;
  56.       board:    array['a'..'h',1..8] of Position_Type;
  57.    end;
  58.    GRecord = record
  59.       Game_State:  Game_State_Type;
  60.       Move_History: Move_History_Type;
  61.    end;
  62.    GFile = file of GRecord;
  63.    FArray = array[1..50] of string;
  64.  
  65.  
  66. var
  67.    Game_State:  Game_State_Type;
  68.    Curr_Move:   Move_Type;
  69.    Move_History: Move_History_Type;
  70.    Coord_List:   Coord_List_Type;
  71.    Game_File:    GFile;
  72.    G:            GRecord;
  73.  
  74.  
  75. Procedure   Border_Square( row, col: integer; scolor : word);
  76.  
  77. Procedure   HiLite_List(List : Coord_List_Type; Count : integer);
  78.  
  79. Procedure    InitScrn ;
  80.  
  81. Procedure    EndPrompt ;
  82.  
  83. Procedure   Beep;
  84.  
  85. Procedure   Prompt(PLine : String);
  86.  
  87. Procedure   Query(PLine : String; var Reply : String);
  88.  
  89. Procedure   Error_Display(Err : String);
  90.  
  91. Procedure   InitGame (var Game_State:Game_State_Type) ;
  92.  
  93. Function    Convert_Row(Row : char ) : integer;
  94.  
  95. Function    Convert_Col(Col : integer) : integer;
  96.  
  97. Function    Convert_File (xFile : char   ) : integer;
  98.  
  99. Function    Convert_Rank (Rank  : integer) : integer;
  100.  
  101. Procedure   Show_Text(var GS : Game_State_Type; var MH : Move_History_Type);
  102.  
  103. implementation
  104.  
  105. Uses
  106.     Crt,Graph ;
  107.  
  108. { ------------------------------------------------------------- }
  109.  
  110.  
  111. procedure Border_Square( row, col: integer; scolor : word);
  112.  
  113. var
  114.   c, r : integer;
  115. begin
  116.    SetColor(sColor);
  117.    SetLineStyle(0,0,1);
  118.    Line(Col, Row, Col+ 34, Row);
  119.    Line(Col, Row+30, Col+34, Row+30);
  120.    Line(Col, Row, Col, Row+30);
  121.    Line(Col+34, Row, Col+34, Row+30);
  122. end;
  123.  
  124.  
  125. { ------------------------------------------------------------- }
  126.  
  127.  
  128. procedure HiLite_List(List : Coord_List_Type; Count : integer);
  129.  
  130.   { HiLite_List           Author: Pete Davis
  131.     Hilight all squares from the legal moves list.
  132.   }
  133.  
  134. var
  135.   Index : integer;
  136. begin
  137.   for Index := 1 to Count do
  138.     Border_Square(Convert_File(List[index].XFile), Convert_Rank(List[index].Rank), 15);
  139.  
  140.   while not keypressed do begin end;
  141.  
  142.   for Index := 1 to Count do
  143.     Border_Square(Convert_File(List[index].XFile), Convert_Rank(List[index].Rank), Brown);
  144. end;
  145.  
  146.  
  147.  
  148. procedure EgaVga; external;
  149.  
  150. { EGAVGA           Author: Pete Davis  (Actually, Borland wrote it.)
  151.   Import EGAVGA support into the program }
  152. {$L EGAVGA.OBJ }
  153.  
  154. procedure Goth; external;
  155.  
  156. { Same as above, except it imports that eye-catching gothic
  157.   character set.
  158. }
  159. {$L GOTH.OBJ }
  160.  
  161. { ------------------------------------------------------------- }
  162.  
  163. procedure InitScrn;
  164.  
  165. { InitScrn                    Author: Pete Davis
  166.   Set the screen up in EGA mode and set-up the gothic character set.
  167.   }
  168. var
  169.   driver,
  170.   mode,
  171.   result : integer;
  172.  
  173. begin
  174.   If RegisterBGIdriver(@EgaVga) < 0 then
  175.     begin
  176.       writeln('Graphics driver could not be loaded. You MUST');
  177.       writeln('be using a VGA or EGA screen to run this program!');
  178.       halt(1);
  179.     end;
  180.  
  181.   result := RegisterBGIfont(@Goth);
  182.  
  183.   driver := EGA;
  184.   mode := EgaHi;
  185.   DirectVideo := false ;
  186.   InitGraph(driver, mode, '');
  187. end;
  188.  
  189. { ------------------------------------------------------------- }
  190.  
  191. Procedure EndPrompt;
  192. begin;
  193.     SetTextStyle(DefaultFont,0,1);
  194.     OutTextXY(205,295,'Press <ENTER> to exit');
  195.     Readln;
  196.     Closegraph;
  197.    TextMode(C80);
  198.    gotoxy(2,2);
  199.     Writeln('Thank you for using Chess-Ter (copyright 1990) The Pascal Team') ;
  200. end;
  201.  
  202.  
  203. { ------------------------------------------------------------- }
  204.  
  205. procedure Beep;
  206.  
  207. begin
  208.    sound(200);
  209.    delay(150);
  210.    nosound;
  211. end;
  212.  
  213. { ------------------------------------------------------------- }
  214.  
  215.  
  216. procedure Prompt(PLine : String);
  217.  
  218. { Prompt           Author: Pete Davis
  219.   Put's a message on line 23 of the screen. Message is auto-centered.
  220. }
  221. begin
  222.   gotoxy((40-(length(PLine) div 2)), 23);
  223.   textcolor(yellow);
  224.   write(PLine);
  225.   gotoxy(1,23);
  226.   while not keypressed do begin end;
  227.   write('                                                                            ');
  228. end;
  229.  
  230. { ------------------------------------------------------------- }
  231.  
  232. procedure Query(PLine : String; var Reply : String);
  233.  
  234. { Query          Author: Pete Davis
  235.    Put's a message on line 23 of the screen. Message is auto-centered.
  236.    The procedure returns a user-supplied reply to the calling procedure.
  237. }
  238. begin
  239.   gotoxy((40-(length(PLine) div 2)), 23);
  240.   textcolor(yellow);
  241.   write(PLine+': ');
  242.   readln(Reply);
  243. end;
  244.  
  245. { ------------------------------------------------------------- }
  246.  
  247. procedure Error_Display(Err : String);
  248.  
  249. { Error_Display           Author: Pete Davis
  250.   Used to display error-messages, mainly. Outputs a centered
  251.   message on line 23 of the screen, in red and supplies a beep.
  252. }
  253. begin
  254.   gotoxy((40-(length(Err) div 2)), 23);
  255.   textcolor(12);
  256.   write(err);
  257.   beep;
  258.   gotoxy(1,23);
  259.   while not keypressed do begin end;
  260.   write('                                                                            ');
  261. end;
  262.  
  263.  
  264. { ------------------------------------------------------------- }
  265.  
  266. Procedure InitGame ( var Game_State:Game_State_Type) ;
  267. var
  268.    ch,
  269.    F : char ;
  270.    R : byte ;
  271.  
  272. begin
  273.    window(1,1,80,25);
  274.    textcolor(0);
  275.    clrscr;
  276.    textcolor(Yellow);
  277.    SetFillStyle(8,Blue);
  278.    FillEllipse(325,175,300,100);
  279.    SetTextStyle(GothicFont, HorizDir, 12);
  280.    SetColor(Yellow);
  281.    OutTextXY(40,100,'Chess-Ter');
  282.    SetTextStyle(DefaultFont, HorizDir, 1);
  283.    OutTextXY(370,220,'(C) 1990 The Pascal Team');
  284.    with Game_State do
  285.    begin
  286.       repeat
  287.         Prompt('Default mode is Novice, do you want to play in Expert Mode ? (y/n)');
  288.         ch:= readkey;
  289.         if not (ch in['y','Y','n','N']) then   BEEP;
  290.       until ch in['y','Y','n','N'];
  291.       TextColor(0);
  292.       clrscr;
  293.       TextColor(15);
  294.       Curr_Move.Move_Kind := Normal ;
  295.       Side_to_move := white ;
  296.       Move_number := 1 ;
  297.       if    ch in ['y','Y'] then Mode:=  expert
  298.       else  Mode:= novice;
  299.  
  300.       Game_Started := false ;
  301.       WKSC_flag := allowed ;
  302.       BKSC_flag := allowed ;
  303.       WQSC_flag := allowed ;
  304.       BQSC_flag := allowed ;
  305.  
  306.       for F := 'a' to 'h' do
  307.       begin
  308.              WEP_flag[F] := denied ;
  309.              BEP_flag[F] := denied ;
  310.       end;
  311.  
  312.       for F := 'a' to 'h' do
  313.          for R := 1 to 8 do
  314.          begin
  315.             board[F,R].piece := nopiece ;
  316.  
  317.             If (R = 1) or (R = 2)
  318.             then
  319.                board[F,R].Side := white
  320.             else
  321.             If (R = 7) or (R = 8)
  322.             then
  323.                board[F,R].Side := black
  324.             else
  325.                board[F,R].Side := noside ;
  326.             end;
  327.  
  328.             FileName := '' ;
  329.             Comment  := '' ;
  330.  
  331.             {* White positions *}
  332.                board['a',1].Piece := rook ;
  333.                board['b',1].Piece := knight ;
  334.                board['c',1].Piece := bishop ;
  335.                board['d',1].Piece := queen ;
  336.                board['e',1].Piece := king ;
  337.                board['f',1].Piece := bishop ;
  338.                board['g',1].Piece := knight ;
  339.                board['h',1].Piece := rook ;
  340.                for F := 'a' to 'h' do
  341.                   board[F,2].Piece := pawn ;
  342.  
  343.             {* Black positions *}
  344.                board['a',8].Piece := rook ;
  345.                board['b',8].Piece := knight ;
  346.                board['c',8].Piece := bishop ;
  347.                board['d',8].Piece := queen ;
  348.                board['e',8].Piece := king ;
  349.                board['f',8].Piece := bishop ;
  350.                board['g',8].Piece := knight ;
  351.                board['h',8].Piece := rook ;
  352.  
  353.                for F := 'a' to 'h' do
  354.                   board[F,7].Piece := pawn ;
  355.           SetTextStyle(GothicFont, HorizDir, 4);
  356.           SetColor(15);
  357.           OutTextXY(210,10,'Chess-Ter 1.0');
  358.         end ;
  359. end;
  360.  
  361. { ------------------------------------------------------------- }
  362.  
  363.  
  364. Function  Convert_Row(Row : char ) : integer;
  365. {
  366.   Convert a letter coordinate to screen coordinate by finding
  367.   value of row.
  368.   NOTE : it is assumed that the board starts at
  369.   180 (column)
  370.   050 (row)
  371. }
  372.  
  373. begin
  374.   Convert_Row := ((ord(row)-65)*30 + 50) ;
  375. end; {* Convert_Row *}
  376.  
  377. { ------------------------------------------------------------- }
  378.  
  379. Function  Convert_Col(Col : integer) : integer;
  380. {
  381.   Convert a letter coordinate to screen coordinate by finding
  382.   value of column.
  383.   NOTE : it is assumed that the board starts at
  384.   180 (column)
  385.   050 (row)
  386. }
  387.  
  388. begin
  389.   Convert_Col := (Col-1)*35 + 166 ;
  390. end; {* Convert_Col *}
  391.  
  392.  
  393. { ------------------------------------------------------------- }
  394.  
  395. Function     Convert_Rank
  396.                 (      rank    : integer    ) {* rank number *}
  397.                                 : integer    ; {* row coord   *}
  398.     {
  399.         Convert a rank designation [1..8] into the appropriate
  400.         screen coordinate.  File is used in the standard chess
  401.         terminology meaning row.  Because the board is rotated,
  402.         each rank is a column.
  403.  
  404.         Starting column is assumed to be at 166, therefore, the
  405.         leftmost    rank (1) is at 166, rank (2) is at 201, etc.
  406.     }
  407.  
  408. begin {* Convert_Rank *}
  409.  
  410.     Convert_Rank := 166 + ((rank-1) * 35) ;
  411.  
  412. end;  {* Convert_Rank *}
  413.  
  414. { ------------------------------------------------------------- }
  415.  
  416. Function  Convert_File
  417.                 (    xFile    : char        ) {* file letter *}
  418.                                 : integer    ; {* col coord   *}
  419.     {
  420.         Convert a file designation [a..h] into the appropriate
  421.         screen coordinate.  Rank is used in the standard chess
  422.         terminology meaning row.  Because the board is rotated,
  423.         each file is a row.
  424.  
  425.         Starting row is assumed to be at 50, therefore file (A)
  426.         is at 50, file (B) is at 80, etc.
  427.     }
  428.  
  429. begin {* Convert_File *}
  430.  
  431.     Convert_File := 50 + ((ord(xFile) - 97) * 30) ;
  432.  
  433. end;  {* Convert_File *}
  434.  
  435. { ------------------------------------------------------------- }
  436. Procedure Display_Move_History(var GS : Game_State_Type;var MH : Move_History_Type);
  437.  
  438. { Display_Move_History         Author: Pete Davis
  439.   Displays the move history for both players on either side of the
  440.   screen.
  441. }
  442. var
  443.   Start,
  444.   Count : integer;
  445.  
  446. begin
  447.   {Clear old move history data}
  448.   TextColor(0);
  449.   window(1,4,20,22);
  450.   clrscr;
  451.   window(59,4,80,22);
  452.   clrscr;
  453.   window(1,1,80,25);
  454.   directvideo:= false;
  455.   textcolor(15);
  456.   gotoxy(3,3);
  457.   write('White Moves');
  458.   gotoxy(61,3);
  459.   write('Black Moves');
  460.   Start := (GS.Move_Number-1) - 34;
  461.   if Start < 1 then Start :=1;
  462.   for Count := Start to (GS.Move_Number-1) do
  463.     begin
  464.       with MH[Count] do
  465.         if odd(Count) then
  466.           begin
  467.             gotoxy(1,5+((count-start) div 2));
  468.             write(Move_Desc);
  469.           end
  470.         else
  471.           begin
  472.             gotoxy(58,5+((count-start) div 2));
  473.             write(Move_Desc);
  474.             write;
  475.           end
  476.     end;
  477. end;
  478.  
  479. procedure Show_Text(var GS : Game_State_Type; var MH : Move_History_Type);
  480.  
  481. { Show_Text         Author: Pete Davis
  482.  
  483.   Displays and updates all necessary text on the screen. Uses
  484.   var parameters to avoid stack overflow.
  485. }
  486.  
  487. begin
  488.   SetTextStyle(GothicFont, HorizDir, 4);
  489.   SetColor(15);
  490.   OutTextXY(210,10,'Chess-Ter 1.0');
  491.   if GS.Mode = expert then
  492.     begin
  493.       DirectVideo := false;
  494.       gotoxy(6,25);
  495.       TextColor(12);
  496.       write('L');
  497.       TextColor(9);
  498.       write('oad');
  499.       gotoxy(19,25);
  500.       TextColor(12);
  501.       write('S');
  502.       TextColor(9);
  503.       write('ave');
  504.       gotoxy(34,25);
  505.       TextColor(12);
  506.       write('R');
  507.       TextColor(9);
  508.       write('eplay');
  509.       gotoxy(50,25);
  510.       TextColor(12);
  511.       write('N');
  512.       TextColor(9);
  513.       write('ew Game');
  514.       gotoxy(68,25);
  515.       TextColor(12);
  516.       write('Q');
  517.       TextColor(9);
  518.       write('uit');
  519.       textcolor(3);
  520.       gotoxy(3,24);
  521.       write('Filename: ');
  522.       write(GS.FileName);
  523.       gotoxy(60,24);
  524.       textcolor(3);
  525.       write('Expert');
  526.       gotoxy(33,24);
  527.       textcolor(15);
  528.       case GS.Side_To_Move of
  529.         white : write('White''s Move');
  530.         black : write('Black''s Move');
  531.       end;
  532.     end;
  533.  
  534.   if GS.Mode = novice then
  535.     begin
  536.       DirectVideo := false;
  537.       gotoxy(4,25);
  538.       TextColor(12);
  539.       write('L');
  540.       TextColor(9);
  541.       write('oad');
  542.       gotoxy(11,25);
  543.       TextColor(12);
  544.       write('S');
  545.       TextColor(9);
  546.       write('ave');
  547.       gotoxy(19,25);
  548.       TextColor(12);
  549.       write('R');
  550.       TextColor(9);
  551.       write('eplay');
  552.       gotoxy(29,25);
  553.       TextColor(12);
  554.       write('T');
  555.       TextColor(9);
  556.       write('akeback');
  557.       gotoxy(41,25);
  558.       write('legal ');
  559.       TextColor(12);
  560.       write('M');
  561.       TextColor(9);
  562.       write('oves');
  563.       gotoxy(56,25);
  564.       TextColor(12);
  565.       write('N');
  566.       TextColor(9);
  567.       write('ew Game');
  568.       gotoxy(68,25);
  569.       TextColor(12);
  570.       write('Q');
  571.       TextColor(9);
  572.       write('uit');
  573.       textcolor(3);
  574.       gotoxy(3,24);
  575.       write('Filename: ');
  576.       write(GS.FileName);
  577.       gotoxy(60,24);
  578.       textcolor(3);
  579.       write('Novice');
  580.       gotoxy(33,24);
  581.       textcolor(15);
  582.       case GS.Side_To_Move of
  583.         white : write('White''s Move');
  584.         black : write('Black''s Move');
  585.       end;
  586.     end;
  587.  
  588.   if GS.Mode = Replaying then
  589.     begin
  590.       DirectVideo := false;
  591.       gotoxy(1,25);
  592.       TextColor(0);
  593.       write('                                                                         ');
  594.       textcolor(3);
  595.       gotoxy(3,24);
  596.       write('Filename: ');
  597.       write(GS.FileName);
  598.       gotoxy(33,24);
  599.       textcolor(0);
  600.       write('             ');
  601.       gotoxy(60,24);
  602.       textcolor(3);
  603.       write('Replay');
  604.     end;
  605.   Display_Move_History(GS, MH);
  606. end;
  607.  
  608.  
  609. end.   {Globals}
  610.  
  611. 
  612.